home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0265 / okimenu.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-06  |  19.3 KB  |  480 lines

  1. 1010  ' *** OKIMENU.BAS   Print Control Menu for Okidata ML92
  2. 1020  '
  3. 1030  KEY OFF: SCREEN 0,1,0,0: WIDTH 80: CLS      'Use 25-line 80-column screen
  4. 1040  DEFINT A-Z: BV=1: CG=0: LI$="?"             'Use integer variables
  5. 1050  ON ERROR GOTO 1060: E=TIMER/3: BV=2: GOTO 1070 'Get BASIC version
  6. 1060  RESUME 1070
  7. 1070  ON ERROR GOTO 0
  8. 1080  DEF SEG=0: IF (PEEK(&H410) AND &H30)<&H30 THEN CG=1 'Color/Graphics
  9. 1090  DEF SEG: IF CG=1 THEN SCREEN 0,1,1,0: CLS   'Build page 1 for C/G
  10. 1100  OPTION BASE 1: DIM PC$(26),PN$(34)          'Print code & name arrays
  11. 1110  '
  12. 1120  LOCATE 2,10: PRINT "OKIDATA MicroLine 92  Print  Control  Menu"
  13. 1130  LOCATE 4,10: PRINT "     Version 2.94      March 20, 1984"
  14. 1140  LOCATE 6,10: PRINT "Copyright (C)1984 BWare SoftWare EveryWare"
  15. 1150  '
  16. 1160  BG=SCREEN(2,10,1): FG=BG MOD 16             'Save foreground color
  17. 1170  BG=(((BG-FG)/16) MOD 128)                   'Save background color
  18. 1180  '
  19. 1190  LOCATE 11
  20. 1200  PRINT "LIMITED WARRANTY:  This program is guaranteed against exterior body rust"
  21. 1210  PRINT "for five years or 50,000 miles, whichever comes first.  No other warranty"
  22. 1220  PRINT "is expressed or implied.  Our motto is CAVEAT EMPTOR!"
  23. 1230  LOCATE 15
  24. 1240  PRINT "SERVICE AGREEMENT:  You get what you pay for!"
  25. 1250  LOCATE 17
  26. 1260  PRINT "LICENSE AGREEMENT:  This program may be freely copied or modified,"
  27. 1270  PRINT "but SALE of this program is STRICTLY FORBIDDEN without the express"
  28. 1280  PRINT "written permission of BWare SoftWare EveryWare.  Remember,"
  29. 1290  PRINT "selling SoftWare from B.S.EveryWare will get you NoWhere!"
  30. 1300  LOCATE 23
  31. 1310  PRINT "This program is made available through the Software Library of the"
  32. 1320  PRINT "Silicon Valley Computer Society, P.O. Box 60506, Sunnyvale, CA 94088";
  33. 1330  IF CG=1 THEN SCREEN ,,0,1: CLS              'Display page 1 for C/G
  34. 1340  '
  35. 1350  E=VAL(MID$(TIME$,7))                        'Get current seconds
  36. 1360  '
  37. 1370  RESTORE 5150                                'Set to read print codes
  38. 1380  FOR I=1 TO 26                               'Load print code array
  39. 1390      READ PN$(I)                             'Read print code name
  40. 1400      READ R                                  'Read next control code
  41. 1410      IF R<255 THEN R$=R$+CHR$(R): GOTO 1400  'Get all codes for function
  42. 1420      PC$(I)=R$: R$="": NEXT I                'Store control codes
  43. 1430  '
  44. 1440  RESTORE 5710                                'Set to read function names
  45. 1450  FOR I=27 TO 34: READ PN$(I): NEXT I         'Load print function names
  46. 1460  '
  47. 1470  IF CG=1 THEN 1550                           'Proceed if Color/Graphics
  48. 1480  IF INKEY$>"" THEN 1540                      'Proceed if any key pressed
  49. 1490  I=VAL(MID$(TIME$,7)): IF I<E THEN I=I+60    'Get current seconds
  50. 1500  IF I-E<10 THEN 1480 ELSE 1540               'Delay 10 seconds
  51. 1510  '
  52. 1520  '*** Start of screen rewrite loop
  53. 1530  IF CG=1 THEN SCREEN ,,0,1                   'Build page 0 for C/G
  54. 1540  CLS
  55. 1550  PRINT "OKIDATA ML92 Print Control Menu";
  56. 1560  LOCATE ,50: PRINT DATE$"    "TIME$: PRINT
  57. 1570  FOR I=1 TO 13: PRINT CHR$(I+64)". "PN$(I);  'Print function name menu
  58. 1580  LOCATE ,41: PRINT CHR$(I+77)". "PN$(I+13): NEXT I
  59. 1590  PRINT: PRINT "** Not compatible with CQ print mode";
  60. 1600  LOCATE ,41: PRINT "* Compatible only with CQ print mode"
  61. 1610  PRINT
  62. 1620  FOR I=27 TO 30: PRINT CHR$(I+22)". "PN$(I); 'Print special function menu
  63. 1630  LOCATE ,41: PRINT CHR$(I+26)". "PN$(I+4): NEXT I
  64. 1640  '
  65. 1650  IF CG=1 THEN SCREEN ,,0,0                   'Display page 0 for C/G
  66. 1660  '
  67. 1670  '*** Start of menu-selection loop
  68. 1680  ON ERROR GOTO 0: GOSUB 2200: COLOR 0,7       'Message in reverse video
  69. 1690  PRINT " Enter selection: ";: COLOR FG,BG
  70. 1700  E=1: L=0: GOSUB 2320                         'Get single unedited char.
  71. 1710  IF R=27 THEN 1530                            'Esc means rewrite screen
  72. 1720  IF R$<"1" THEN 1820 ELSE IF R$>"8" THEN 1800 'Skip if not print function
  73. 1730  '
  74. 1740  PF=R-48: R=PF+26: GOSUB 2190: PRINT PN$(R);  'Display print function name
  75. 1750  ON PF GOSUB 3610,3770,3840,4260,4690,4870,5020,5070 'Do menu items 1-8
  76. 1760  GOSUB 2200: IF PF=4 OR PF=5 THEN 1530        'Rewrite screen for 4 & 5
  77. 1770  GOTO 1680                                    'Continue with next selection
  78. 1780  '
  79. 1790  '*** Process menu selections A-Z
  80. 1800  R=R-64                                       'Convert letter to subscript
  81. 1810  IF R>0 AND R<27 THEN 1850                    'Check for invalid selections
  82. 1820  GOSUB 2190: BEEP                             'Clear line 24
  83. 1830  PRINT "Invalid selection";: GOTO 1700        'Handle invalid selections
  84. 1840  '
  85. 1850  A$=PC$(R): IF A$="" THEN 1820                'Retrieve print code
  86. 1860  GOSUB 2190: PRINT PN$(R);                    'Display print function name
  87. 1870  LOCATE ,41: PRINT "Make sure printer is ready";
  88. 1880  IF R=12 THEN LI$="6": GOTO 1970              'L. Lines per inch
  89. 1890  IF R=13 THEN LI$="8": GOTO 1970              'M. Lines per inch
  90. 1900  IF R=16 THEN GOSUB 2550: GOTO 1960           'P. Sub/superscripts on
  91. 1910  IF R=18 THEN GOSUB 2670: GOTO 1970           'R. Set variable tabs
  92. 1920  IF R=19 THEN GOSUB 2860: GOTO 1970           'S. Set fixed tabs
  93. 1930  IF R=21 THEN GOSUB 3110: GOTO 1970           'U. Page length
  94. 1940  IF R=24 THEN GOSUB 3240: GOTO 1970           'X. Skip lines
  95. 1950  IF R=25 THEN GOSUB 3360: GOTO 1970           'Y. Left margin
  96. 1960  IF R=26 THEN GOSUB 3490                      'Z. Space between characters
  97. 1970  GOSUB 2030: GOTO 1680                        'Print codes & start over
  98. 1980  '
  99. 1990  '
  100. 2000  '
  101. 2010  '
  102. 2020  '*** Sub-routine to send print codes
  103. 2030  ON ERROR GOTO 2080                           'Set error catcher
  104. 2040  OPEN "R",#1,"LPT1:": WIDTH #1,255            'Open printer/no LF's
  105. 2050  PRINT #1,A$;                                 'Send print string
  106. 2060  CLOSE #1: ON ERROR GOTO 0: RETURN            'Close & return
  107. 2070  '
  108. 2080  IF ERR=55 THEN CLOSE: RESUME                 'Ignore "Open file" error
  109. 2090  IF ERL<>2050 THEN ON ERROR GOTO 0            'Must be print error
  110. 2100  GOSUB 2210: PRINT "Check printer - press <Enter> to continue";
  111. 2110  LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
  112. 2120  BEEP: E=1: L=0: GOSUB 2320                   'Get response
  113. 2130  IF R=27 THEN RESUME 2060                     'Esc means cancel
  114. 2140  IF R=13 THEN RESUME ELSE 2120                'Ignore if not Enter key
  115. 2150  '
  116. 2160  '
  117. 2170  '
  118. 2180  '*** Sub-routines to clear lines 24 & 25
  119. 2190  LOCATE 24,1: PRINT SPACE$(79);: LOCATE 24,1: RETURN  'Clear line 24
  120. 2200  LOCATE 24,41: PRINT SPACE$(39);                      'Clear line 24 right
  121. 2210  LOCATE 25,1: PRINT SPACE$(79);: LOCATE 25,1: RETURN  'Clear line 25
  122. 2220  '
  123. 2230  '
  124. 2240  '
  125. 2250  '*** Sub-routine to get keyboard response (terminated by <Enter>)
  126. 2260  '*** E=1 is no edit / E=2 is alpha edit / E=3 is numeric edit
  127. 2270  '*** E=4 is numeric edit terminated by comma or <Enter>
  128. 2280  '*** L is the maximum length of response (0=one unprinted character)
  129. 2290  '*** R$ is the last character entered
  130. 2300  '*** R is the ASCII code of R$
  131. 2310  '*** S$ is the cumulative string entered
  132. 2320  S$="": X=CSRLIN: Y=POS(0): GOTO 2340      'Initialize string
  133. 2330  BEEP                                      'Complain if wrong key pressed
  134. 2340  R$=INKEY$: IF R$="" THEN LOCATE 1,64,0: PRINT TIME$;: GOTO 2340 'Get char.
  135. 2350  IF LEN(R$)>1 THEN 2330                    'Ignore extended codes
  136. 2360  R=ASC(R$): IF R=13 THEN RETURN            '<Enter> key ends response
  137. 2370  IF R=27 THEN S$="": RETURN                '<Esc> key cancels response
  138. 2380  IF R=8 THEN 2470                          'Special handling for BackSpace
  139. 2390  IF R>96 AND R<123 THEN R=R-32: R$=CHR$(R) 'Force uppercase letters
  140. 2400  ON E GOTO 2440,2430,2420,2410: GOTO 2330  'Check edit type
  141. 2410  IF R$="," THEN RETURN                     'Comma ends input for edit 4
  142. 2420  IF R$<"0" OR R$>"9" THEN 2330 ELSE 2440   'Edit numeric entry
  143. 2430  IF R$<"A" OR R$>"Z" THEN 2330             'Edit alphabetic entry
  144. 2440  IF L=0 THEN RETURN                        'Do not print character if L=0
  145. 2450  S$=S$+R$: Y=Y+1: LOCATE X,Y: PRINT R$;    'Add new character to string
  146. 2460  IF LEN(S$)<L THEN 2340 ELSE RETURN        'Keep going until max. response
  147. 2470  IF LEN(S$)<1 THEN 2330                    'Ignore BackSpace if no string
  148. 2480  S$=LEFT$(S$,LEN(S$)-1)                    'Delete last character
  149. 2490  LOCATE X,Y: Y=Y-1: PRINT CHR$(32);        'Erase character from screen
  150. 2500  GOTO 2340                                 'Get next character
  151. 2510  '
  152. 2520  '
  153. 2530  '
  154. 2540  '*** Sub-routine to turn on subscripts or superscripts
  155. 2550  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  156. 2560  GOSUB 2210: COLOR 0,7
  157. 2570  PRINT " Type <B> for subscripts, <P> for superscripts: ";
  158. 2580  COLOR FG,BG: E=2: L=1: GOSUB 2320         'Get suB/suPerscript choice
  159. 2590  IF R=27 THEN A$="": RETURN                'Esc means cancel
  160. 2600  IF R$="B" THEN RETURN                     'Subscripts chosen
  161. 2610  IF R$<>"P" THEN BEEP: GOTO 2560           'Try again if not suPerscripts
  162. 2620  A$=CHR$(27)+"K"+CHR$(27)+"M"+CHR$(27)+"J": RETURN 'Set control string
  163. 2630  '
  164. 2640  '
  165. 2650  '
  166. 2660  '*** Sub-routine to set variable horizontal tab stops
  167. 2670  TB$="": LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  168. 2680  GOSUB 2210: COLOR 0,7: PRINT " Enter columns (1-255)";
  169. 2690  COLOR FG,BG: PRINT TB$+" ";               'Show tabs entered so far
  170. 2700  E=4: L=4: GOSUB 2320                      'Get column number
  171. 2710  IF R=27 THEN A$="": RETURN                'Esc means cancel
  172. 2720  IF LEN(S$)=0 THEN 2800                    'No entry means finished
  173. 2730  R=VAL(S$)                                 'Get column number
  174. 2740  IF R=0 OR R>255 THEN BEEP: GOTO 2680      'Column must be 1-255
  175. 2750  IF LEN(S$)<3 THEN S$="0"+S$: GOTO 2750    'Must be 3-digit tab column
  176. 2760  IF LEN(S$)>3 THEN BEEP: GOTO 2680         'Can't be more than 3 digits
  177. 2770  IF TB$>"" THEN TB$=TB$+","                'Need comma between tabs
  178. 2780  TB$=TB$+S$: IF R>233 THEN 2800            'Only one tab allowed 234-255
  179. 2790  IF LEN(TB$)<52 THEN 2680                  'Room for 14 tabs on line
  180. 2800  IF LEN(TB$)=0 THEN A$="": RETURN          'Done if no entry
  181. 2810  A$=A$+TB$+CHR$(13): RETURN                'Set tab string
  182. 2820  '
  183. 2830  '
  184. 2840  '
  185. 2850  '*** Sub-routine to set fixed horizontal tab stops
  186. 2860  TB$="": LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  187. 2870  GOSUB 2210: COLOR 0,7                     'Clear line 25 & reverse video
  188. 2880  PRINT " Enter number of columns between tab stops ";
  189. 2890  COLOR FG,BG: E=3: L=4: GOSUB 2320         'Get tab interval
  190. 2900  IF R=27 THEN A$="": RETURN                'Esc means cancel
  191. 2910  IF LEN(S$)=0 THEN A$="": RETURN           'No entry means finished
  192. 2920  IF LEN(S$)>3 THEN BEEP: GOTO 2870         'Only 3 digits allowed
  193. 2930  R=VAL(S$): A=R+1                          'Get starting tab column
  194. 2940  IF R=0 OR R>254 THEN BEEP: GOTO 2870      'Tab interval must be 1-254
  195. 2950  FOR I=1 TO 16                             'Limit is 16 tab stops
  196. 2960     IF A>255 THEN 3030                     'Column cannot exceed 255
  197. 2970     S$=MID$(STR$(A),2)                     'Convert column number to string
  198. 2980     IF LEN(S$)<3 THEN S$="0"+S$: GOTO 2980 'Must be 3-digit column number
  199. 2990     IF TB$>"" THEN TB$=TB$+","             'Need comma between tabs
  200. 3000     TB$=TB$+S$                             'Store tab string
  201. 3010     IF A>233 THEN 3030 ELSE A=A+R          'Only one tab allowed 234-255
  202. 3020  NEXT I
  203. 3030  GOSUB 2190: PRINT "Tabs set at "TB$;      'Show tab stops
  204. 3040  A$=A$+TB$+CHR$(13)                        'Set tab string
  205. 3050  LOCATE 25,52: PRINT "Press any key to continue";
  206. 3060  IF INKEY$="" THEN 3060 ELSE GOSUB 2190: RETURN
  207. 3070  '
  208. 3080  '
  209. 3090  '
  210. 3100  '*** Sub-routine to get number of lines/page
  211. 3110  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  212. 3120  GOSUB 2210: COLOR 0,7
  213. 3130  PRINT " Enter number of lines per page (00-99) at "LI$" LPI: ";
  214. 3140  COLOR FG,BG: E=3: L=3: GOSUB 2320         'Get number of lines
  215. 3150  IF R=27 THEN A$="": RETURN                'Esc means cancel
  216. 3160  IF LEN(S$)=1 THEN S$="0"+S$: GOTO 3180
  217. 3170  IF LEN(S$)>2 THEN BEEP: GOTO 3120
  218. 3180  A$=A$+S$: GOSUB 2190
  219. 3190  PRINT "Form length set to "S$" lines at "LI$" LPI";: RETURN
  220. 3200  '
  221. 3210  '
  222. 3220  '
  223. 3230  '*** Sub-routine to get number of lines to skip
  224. 3240  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  225. 3250  GOSUB 2210: COLOR 0,7
  226. 3260  PRINT " Enter number of lines to skip (00-99): ";
  227. 3270  COLOR FG,BG: E=3: L=3: GOSUB 2320         'Get number of lines
  228. 3280  IF R=27 THEN A$="": RETURN                'Esc means cancel
  229. 3290  IF LEN(S$)=1 THEN S$="0"+S$: GOTO 3310
  230. 3300  IF LEN(S$)>2 THEN BEEP: GOTO 3250
  231. 3310  A$=A$+S$: RETURN
  232. 3320  '
  233. 3330  '
  234. 3340  '
  235. 3350  '*** Sub-routine to get left margin print position
  236. 3360  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  237. 3370  GOSUB 2210: COLOR 0,7
  238. 3380  PRINT " Enter left margin column number (1-90): ";
  239. 3390  COLOR FG,BG: E=3: L=4: GOSUB 2320         'Get column number
  240. 3400  IF R=27 THEN A$="": RETURN ELSE R=VAL(S$) 'Esc means cancel
  241. 3410  IF R<1 OR R>90 THEN BEEP: GOTO 3370       'Must be column 1-90
  242. 3420  S$=MID$(STR$(VAL(S$)*10-9),2)             'Multiply by 10 dots/inch
  243. 3430  IF LEN(S$)<3 THEN S$="0"+S$: GOTO 3430    'Make it 3 digits
  244. 3440  A$=A$+S$: RETURN
  245. 3450  '
  246. 3460  '
  247. 3470  '
  248. 3480  '*** Sub-routine to get spacing between characters (# of 1/120's)
  249. 3490  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  250. 3500  GOSUB 2210: COLOR 0,7
  251. 3510  PRINT " Enter number of 1/120-inch spaces between characters (0-9): ";
  252. 3520  COLOR FG,BG: E=3: L=2: GOSUB 2320         'Get number of 1/120's
  253. 3530  IF R=27 THEN A$="": RETURN                'Esc means cancel
  254. 3540  IF LEN(S$)>1 THEN BEEP: GOTO 3500
  255. 3550  A$=A$+CHR$(ASC(S$)-48): RETURN
  256. 3560  '
  257. 3570  '
  258. 3580  '
  259. 3590  '
  260. 3600  '*** Sub-routine to download Italics character set
  261. 3610  D$="": BAS$="OKITALIC.BAS"
  262. 3620  ON ERROR GOTO 3650
  263. 3630  OPEN "I",#1,D$+BAS$: CLOSE: ON ERROR GOTO 0
  264. 3640  CHAIN D$+BAS$,2020
  265. 3650  RESUME 3660
  266. 3660  ON ERROR GOTO 0: GOSUB 2210: COLOR 0,7
  267. 3670  PRINT " Enter letter of drive containing "BAS$": ";
  268. 3680  BEEP: COLOR FG,BG
  269. 3690  LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
  270. 3700  LOCATE 25,50: E=2: L=1: GOSUB 2320        'Get drive letter
  271. 3710  IF R=27 THEN RETURN                       'Esc means cancel
  272. 3720  D$=R$+":": GOTO 3620
  273. 3730  '
  274. 3740  '
  275. 3750  '
  276. 3760  '*** Sub-routine to do a print test
  277. 3770  LOCATE ,41: PRINT "Make sure printer is ready";
  278. 3780  A$="": FOR I=32 TO 127: A$=A$+CHR$(I): NEXT I
  279. 3790  A$=A$+CHR$(13)+CHR$(10): GOSUB 2030: RETURN
  280. 3800  '
  281. 3810  '
  282. 3820  '
  283. 3830  '*** Sub-routine to print an ASCII text file
  284. 3840  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  285. 3850  GOSUB 2210: COLOR 0,7
  286. 3860  PRINT " Enter number of print lines per page: ";
  287. 3870  COLOR FG,BG: E=3: L=4: GOSUB 2320         'Get response
  288. 3880  IF R=27 THEN RETURN                       'Esc means cancel
  289. 3890  IF S$="" THEN PL=-1: LP=PL: GOTO 3920     'Set no-line-check
  290. 3900  PL=VAL(S$): LP=PL: GOTO 3920              'Set # lines per page
  291. 3910  LOCATE ,41: PRINT "Press <Esc> to cancel selection";
  292. 3920  GOSUB 2210: COLOR 0,7
  293. 3930  PRINT " Enter name of ASCII text file: ";
  294. 3940  COLOR FG,BG: E=1: L=15: GOSUB 2320        'Get file name
  295. 3950  IF S$="" THEN RETURN                      'Skip it if no file name
  296. 3960  ON ERROR GOTO 4140                        'Set error-catcher
  297. 3970  OPEN "I",#2,S$                            'Open the file
  298. 3980  IF EOF(2) THEN GOSUB 2190: PRINT S$" is an empty file";: GOTO 4120
  299. 3990  LINE INPUT #2,A$: IF A$="" THEN 4040      'Check for blank first line
  300. 4000  R=ASC(A$): IF R<128 THEN 4020             'Check for non-ASCII file
  301. 4010  GOSUB 2190: PRINT S$" is not an ASCII file";: CLOSE: GOTO 3910
  302. 4020  IF R<>12 THEN 4040                        'Check for form-feed to start
  303. 4030  IF LEN(A$)<2 THEN 3990 ELSE A$=MID$(A$,2) 'Delete starting form-feed
  304. 4040  LOCATE 24,1: PRINT SPACE$(40);: LOCATE ,1: PRINT "Printing "S$;
  305. 4050  OPEN "O",#1,"LPT1:": WIDTH #1,255: GOTO 4090 'Ready the printer
  306. 4060  '
  307. 4070  IF EOF(2) THEN PRINT #1,CHR$(12);: GOTO 4120 'Check for end of file
  308. 4080  LINE INPUT #2,A$                             'Read the next line
  309. 4090  IF LP=0 THEN LP=PL: PRINT #1,CHR$(12);       'Form-feed after PL lines
  310. 4100  PRINT #1,A$: IF LP>0 THEN LP=LP-1            'Print the line
  311. 4110  R$=INKEY$: IF R$="" THEN 4070 ELSE IF ASC(R$)<>27 THEN 4110 'Continue
  312. 4120  CLOSE: ON ERROR GOTO 0: RETURN               'Close files - all done
  313. 4130  '
  314. 4140  IF ERL=3970 THEN 4160 ELSE IF ERL=4100 THEN 4170
  315. 4150  IF ERL=3990 THEN RESUME 4010 ELSE ON ERROR GOTO 0
  316. 4160  GOSUB 2190: PRINT "Bad file name - try again";: RESUME 3910
  317. 4170  GOSUB 2210: PRINT "Check printer - press <Enter> when ready";
  318. 4180  BEEP: E=1: L=0: GOSUB 2320                   'Get response
  319. 4190  IF R=27 THEN RESUME 4120                     'Esc means cancel
  320. 4200  IF R=13 THEN RESUME 4100 ELSE 4180           'Ignore if not Enter key
  321. 4210  '
  322. 4220  '
  323. 4230  '
  324. 4240  '*** Sub-routine to print disk directory in standard DOS format
  325. 4250  '*** using DOS & BASIC 2.0 features.
  326. 4260  IF BV=2 THEN 4280 ELSE BEEP: PF=0           'Function requires BASIC 2.00
  327. 4270  GOSUB 2190: PRINT "Sorry - BASIC 2.00 function";: RETURN
  328. 4280  CLS: LOCATE 2: PRINT PN$(R)
  329. 4290  PRINT: PRINT "Press <Esc> to cancel selection"
  330. 4300  PRINT: COLOR 0,7
  331. 4310  PRINT " Enter letter of disk drive: ";: COLOR FG,BG
  332. 4320  E=2: L=O: GOSUB 2320                        'Get response
  333. 4330  IF R=27 THEN RETURN                         'Esc means exit
  334. 4340  IF R$<"E" THEN 4360                         'Only valid drive letters
  335. 4350  S$="": GOSUB 2330: GOTO 4330                'Try another letter
  336. 4360  LOCATE X,Y: PRINT R$: D$=R$                 'Show drive letter
  337. 4370  '
  338. 4380  PRINT: PRINT "Make sure printer is ready";
  339. 4390  ON ERROR GOTO 4570: OPEN "R",#1,"LPT1:": WIDTH #1,255
  340. 4400  PRINT #1,CHR$(17)CHR$(24)CHR$(27)"1"CHR$(30)CHR$(28)CHR$(27)"8"
  341. 4410  PRINT #1,CHR$(27)"%C001": CLOSE: ON ERROR GOTO 0
  342. 4420  '
  343. 4430  CMD$="dir "+D$+":>prn": GOSUB 4520          'Print the disk directory
  344. 4440  PRINT: PRINT: PRINT: PRINT
  345. 4450  '
  346. 4460  ON ERROR GOTO 4570: OPEN "R",#1,"LPT1:": WIDTH #1,255
  347. 4470  PRINT #1,CHR$(13)+CHR$(10)+CHR$(10): CLOSE: ON ERROR GOTO 0
  348. 4480  '
  349. 4490  CMD$="chkdsk "+D$+":>prn": GOSUB 4520       'Print the chkdsk report
  350. 4500  RETURN
  351. 4510  '
  352. 4520  DEF SEG: A=PEEK(&H30): B=PEEK(&H31)         'Save BASIC's current segment
  353. 4530  SHELL CMD$                                  'Execute the DOS command
  354. 4540  POKE &H30,A: POKE &H31,B                    'Restore BASIC's segment
  355. 4550  RETURN
  356. 4560  '
  357. 4570  IF ERR=55 THEN CLOSE: RESUME                'Ignore "File already open"
  358. 4580  CLS: IF ERR=24 OR ERR=25 THEN PRINT "Printer is not ready": RESUME 4610
  359. 4590  IF ERR=27 THEN PRINT "Printer is out of paper": RESUME 4610
  360. 4600  ON ERROR GOTO 0                             'For unexpected errors
  361. 4610  PRINT "Press <Enter> when ready to continue (Esc to exit)"
  362. 4620  BEEP: E=1: L=0: GOSUB 2320                  'Get response
  363. 4630  IF R=27 THEN ON ERROR GOTO 0: CLOSE: RETURN 'Esc means exit
  364. 4640  IF R<>13 THEN 4620                          'Enter means try again
  365. 4645  IF ERL < 4460 THEN 4400 ELSE 4470           'Choose retry line
  366. 4650  '
  367. 4660  '
  368. 4670  '
  369. 4680  '*** Sub-routine to display disk directory
  370. 4690  LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
  371. 4700  GOSUB 2210: COLOR 0,7
  372. 4710  PRINT " Enter letter of disk drive: ";: COLOR FG,BG
  373. 4720  E=2: L=1: GOSUB 2320                         'Get response
  374. 4730  IF R=27 THEN RETURN                          'Esc means cancel
  375. 4740  IF S$>"D" THEN BEEP: LOCATE X,Y-1: GOTO 4720 'Check valid drive letter
  376. 4750  IF CG=1 THEN SCREEN ,,2,0                    'Build page 2 for C/G
  377. 4760  CLS: IF BV=1 THEN PRINT "Disk drive "R$":"
  378. 4770  ON ERROR GOTO 4810: FILES R$+":*.*"          'Display directory
  379. 4780  ON ERROR GOTO 0: LOCATE 25,41: PRINT "Press any key to continue";
  380. 4790  IF CG=1 THEN SCREEN ,,2,2                    'Display page 2 for C/G
  381. 4800  E=1: L=0: GOSUB 2320: RETURN                 'Get entry & return
  382. 4810  RESUME 4820
  383. 4820  ON ERROR GOTO 0: GOTO 4690                   'Try again
  384. 4830  '
  385. 4840  '
  386. 4850  '
  387. 4860  '*** Sub-routine to exit to MENU
  388. 4870  D$="": BAS$="MENU.BAS"
  389. 4880  ON ERROR GOTO 4900: OPEN "I",#1,D$+BAS$: CLOSE: ON ERROR GOTO 0
  390. 4890  CLS: CHAIN D$+BAS$
  391. 4900  RESUME 4910
  392. 4910  ON ERROR GOTO 0: GOSUB 2210: COLOR 0,7
  393. 4920  PRINT " Enter letter of drive containing "BAS$": ";
  394. 4930  BEEP: COLOR FG,BG
  395. 4940  LOCATE 24,41: PRINT "Press <Esc> to cancel selection";
  396. 4950  LOCATE 25,46: E=2: L=1: GOSUB 2320
  397. 4960  IF R=27 THEN RETURN                          'Esc means cancel
  398. 4970  D$=R$+":": GOTO 4880
  399. 4980  '
  400. 4990  '
  401. 5000  '
  402. 5010  '*** Sub-routine to exit to BASIC
  403. 5020  ON ERROR GOTO 0: SCREEN 0,1,0,0: CLS: END
  404. 5030  '
  405. 5040  '
  406. 5050  '
  407. 5060  '*** Sub-routine to exit to DOS
  408. 5070  CLS: SYSTEM
  409. 5080  '
  410. 5090  '
  411. 5100  '
  412. 5110  '*** Print control codes & names
  413. 5120  '*** Menu items A-Z
  414. 5130  '*** Control code names precede codes
  415. 5140  '*** End each code sequence with 255
  416. 5150  DATA "Clear print buffer & reset printer"
  417. 5160  DATA 17,24,255
  418. 5170  DATA "Data Processing print mode"
  419. 5180  DATA 27,48,255
  420. 5190  DATA "Correspondence Quality print mode"
  421. 5200  DATA 27,49,255
  422. 5210  DATA "Downloaded Character print mode"
  423. 5220  DATA 27,50,255
  424. 5230  DATA "Enhanced printing **"
  425. 5240  DATA 27,72,255
  426. 5250  DATA "Emphasized printing **"
  427. 5260  DATA 27,84,255
  428. 5270  DATA "Stop enhanced/emphasized printing"
  429. 5280  DATA 27,73,255
  430. 5290  DATA "10 characters per inch"
  431. 5300  DATA 30,255
  432. 5310  DATA "12 characters per inch"
  433. 5320  DATA 30,28,255
  434. 5330  DATA "17 characters per inch **"
  435. 5340  DATA 30,29,255
  436. 5350  DATA "Double-width characters"
  437. 5360  DATA 31,255
  438. 5370  DATA "6 lines per inch"
  439. 5380  DATA 27,54,255
  440. 5390  DATA "8 lines per inch"
  441. 5400  DATA 27,56,255
  442. 5410  DATA "Underlining on"
  443. 5420  DATA 27,67,255
  444. 5430  DATA "Underlining off"
  445. 5440  DATA 27,68,255
  446. 5450  DATA "Subscripts/superscripts on"
  447. 5460  DATA 27,77,27,75,27,76,255
  448. 5470  DATA "Subscripts/superscripts off"
  449. 5480  DATA 27,75,27,77,255
  450. 5490  DATA "Set variable horizontal tab stops"
  451. 5500  DATA 27,09,255
  452. 5510  DATA "Set fixed horizontal tab stops"
  453. 5520  DATA 27,09,255
  454. 5530  DATA "Clear all tab stops"
  455. 5540  DATA 27,09,13,255
  456. 5550  DATA "Set form length (for form-feeds)"
  457. 5560  DATA 27,70,255
  458. 5570  DATA "Set top-of-form"
  459. 5580  DATA 27,05,255
  460. 5590  DATA "Advance to top-of-form"
  461. 5600  DATA 12,255
  462. 5610  DATA "Skip 01-99 lines"
  463. 5620  DATA 27,11,255
  464. 5630  DATA "Set left margin"
  465. 5640  DATA 27,37,67,255
  466. 5650  DATA "Set space between characters *"
  467. 5660  DATA 27,78,255
  468. 5670  '
  469. 5680  '
  470. 5690  '*** Print-related functions
  471. 5700  '*** Menu items 1-8
  472. 5710  DATA "Download Italics character set"
  473. 5720  DATA "Print test--all ASCII characters"
  474. 5730  DATA "Print an ASCII text file"
  475. 5740  DATA "Print disk directory (BASIC 2.00)"
  476. 5750  DATA "Display disk directory"
  477. 5760  DATA "Exit to MENU"
  478. 5770  DATA "Exit to BASIC"
  479. 5780  DATA "Exit to DOS"
  480.